home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / dviware / dvitovdu32 / src / pascal / options.p < prev    next >
Text File  |  1991-11-10  |  12KB  |  351 lines
  1. (* This module initializes the DVI file parameter and command line options.
  2.    Highly SYSDEP!
  3. *)
  4.  
  5. #include 'globals.h';
  6. #include 'screenio.h';
  7. #include 'options.h';
  8.  
  9. TYPE
  10.    units = (ic,cm,mm,pc,pt,px);
  11.  
  12. VAR
  13.    option : CHAR;       (* current command option *)
  14.    value : string;      (* current option's value *)
  15.    vlength : INTEGER;   (* current value's length *)
  16.    argnum : INTEGER;    (* 0..argc-1; used in argv calls *)
  17.  
  18. FUNCTION sscanf (VAR s, format : string; VAR r : real) : integer;
  19. EXTERNAL;
  20.  
  21. (******************************************************************************)
  22.  
  23. FUNCTION Cap (ch : CHAR) : CHAR;
  24.  
  25. (* If ch is in 'a'..'z' then return capitalized letter else return ch. *)
  26.  
  27. BEGIN
  28. IF (ch < 'a') OR (ch > 'z') THEN Cap := ch ELSE Cap := CHR(ORD(ch) - 32);
  29. END; (* Cap *)
  30.  
  31. (******************************************************************************)
  32.  
  33. FUNCTION Len (str : string) : INTEGER;
  34.  
  35. (* Return length of given string. *)
  36.  
  37. LABEL 888;
  38.  
  39. VAR i : INTEGER;
  40.  
  41. BEGIN
  42. i := maxstring;
  43. WHILE i > 0 DO BEGIN
  44.    IF str[i-1] <> ' ' THEN goto 888;
  45.    i := i - 1;
  46. END;
  47. 888:
  48. Len := i;
  49. END; (* Len *)
  50.  
  51. (******************************************************************************)
  52.  
  53. FUNCTION ExplicitExt (fname : string; len : INTEGER) : BOOLEAN;
  54.  
  55. (* SYSDEP: Check for an extension of the form ".*" where * is any string
  56.    not containing "/".  len is length of fname.
  57.    If "." found then TRUE is returned, otherwise FALSE.
  58. *)
  59.  
  60. LABEL 999;
  61.  
  62. BEGIN
  63. WHILE len > 0 DO BEGIN   (* search backwards looking for . *)
  64.    len := len - 1;
  65.    IF fname[len] = '/' THEN BEGIN   (* handle file names like ../myfiles/foo *)
  66.       ExplicitExt := FALSE;
  67.       goto 999;
  68.    END
  69.    ELSE IF fname[len] = '.' THEN BEGIN
  70.       ExplicitExt := TRUE;
  71.       goto 999;
  72.    END;
  73. END;
  74. ExplicitExt := FALSE;
  75. 999:
  76. END; (* ExplicitExt *)
  77.  
  78. (******************************************************************************)
  79.  
  80. PROCEDURE GetValue;
  81.  
  82. (* Get parameter following current option and store in value. *)
  83.  
  84. VAR i : integer;
  85.  
  86. BEGIN
  87. IF vlength > 2 THEN BEGIN                      (* allow things like -m1000 *)
  88.    FOR i := 0 TO vlength - 1 DO
  89.       value[i] := value[i+2];                  (* shift value left 2 places *)
  90.    vlength := vlength - 2;
  91. END
  92. ELSE BEGIN
  93.    (* option should be followed by value *)
  94.    value := ' ';
  95.    IF argnum < argc THEN argv(argnum,value);
  96.    vlength := Len(value);                      (* 0 if no more args *)
  97.    argnum := argnum + 1;
  98.    IF vlength <= 0 THEN BEGIN
  99.       WriteString('Missing value after -'); WriteChar(option); WriteLine;
  100.       RestoreTerminal; exit(1);
  101.    END;
  102. END;
  103. END; (* GetValue *)
  104.  
  105. (******************************************************************************)
  106.  
  107. PROCEDURE GetCardinal (VAR n : INTEGER);
  108.  
  109. (* If current value represents a positive integer then return via n. *)
  110.  
  111. VAR result : integer;   r : real;   fmt : string;
  112.  
  113. BEGIN
  114. fmt := '%f';
  115. result := sscanf(value,fmt,r);
  116. n := trunc(r + 0.5);
  117. (* result can be 1 or -1 if ok! *)
  118. IF (ABS(result) <> 1) OR (n <= 0) THEN BEGIN
  119.    WriteString('Bad -'); WriteChar(option);
  120.    WriteString(' value:'); WriteChar(' '); WriteString(value); WriteLine;
  121.    WriteString('Specify a positive integer.'); WriteLine;
  122.    RestoreTerminal; exit(1);
  123. END;
  124. END; (* GetCardinal *)
  125.  
  126. (******************************************************************************)
  127.  
  128. PROCEDURE GetPosDimen (VAR r : REAL; VAR un : units);
  129.  
  130. (* A valid +ve dimension consists of a positive integer or real number followed
  131.    by a two-letter unit: cm, mm, in, pc, pt or px (or in uppercase).
  132.    If current value represents a valid dimension, we return number part in r
  133.    and units part in un.
  134. *)
  135.  
  136. VAR i, result : INTEGER;   ch1, ch2 : CHAR;   fmt : string;
  137.  
  138. BEGIN
  139. (* extract un *)
  140. IF vlength > 1 THEN i := vlength-1 ELSE i := 1;
  141. IF (Cap(value[i-1]) = 'I') AND (Cap(value[i]) = 'N') THEN
  142.    un := ic
  143. ELSE IF (Cap(value[i-1]) = 'C') AND (Cap(value[i]) = 'M') THEN
  144.    un := cm
  145. ELSE IF (Cap(value[i-1]) = 'M') AND (Cap(value[i]) = 'M') THEN
  146.    un := mm
  147. ELSE IF (Cap(value[i-1]) = 'P') AND (Cap(value[i]) = 'C') THEN
  148.    un := pc
  149. ELSE IF (Cap(value[i-1]) = 'P') AND (Cap(value[i]) = 'T') THEN
  150.    un := pt
  151. ELSE IF (Cap(value[i-1]) = 'P') AND (Cap(value[i]) = 'X') THEN
  152.    un := px
  153. ELSE BEGIN
  154.    WriteString('Bad units in -'); WriteChar(option);
  155.    WriteString(' value:'); WriteChar(' '); WriteString(value); WriteLine;
  156.    WriteString('Last two letters should be cm, mm, in, pc, pt or px.');
  157.    WriteLine; RestoreTerminal; exit(1);
  158. END;
  159. ch1 := value[i-1];                           (* remember letters in units *)
  160. ch2 := value[i];
  161. value[i]   := ' ';                           (* remove units *)
  162. value[i-1] := ' ';
  163. fmt := '%f';
  164. result := sscanf(value,fmt,r);
  165. (* result can be 1 or -1 if ok! *)
  166. IF (ABS(result) <> 1) OR (r <= 0.0) THEN BEGIN
  167.    value[i-1] := ch1;                        (* restore units *)
  168.    value[i]   := ch2;
  169.    WriteString('Bad -'); WriteChar(option);
  170.    WriteString(' value:'); WriteChar(' '); WriteString(value); WriteLine;
  171.    WriteString('Specify a positive dimension.'); WriteLine;
  172.    RestoreTerminal; exit(1);
  173. END;
  174. END; (* GetPosDimen *)
  175.  
  176. (******************************************************************************)
  177.  
  178. PROCEDURE GetDimen (VAR r : REAL; VAR un : units);
  179.  
  180. (* A valid dimension consists of an integer or real number followed
  181.    by a two-letter unit: cm, mm, in, pc, pt or px (or in uppercase).
  182.    If current value represents a valid dimension, we return number part in r
  183.    and units part in un.
  184. *)
  185.  
  186. VAR i, result : INTEGER;   ch1, ch2 : CHAR;   fmt : string;
  187.  
  188. BEGIN
  189. (* extract un *)
  190. IF vlength > 1 THEN i := vlength-1 ELSE i := 1;
  191. IF (Cap(value[i-1]) = 'I') AND (Cap(value[i]) = 'N') THEN
  192.    un := ic
  193. ELSE IF (Cap(value[i-1]) = 'C') AND (Cap(value[i]) = 'M') THEN
  194.    un := cm
  195. ELSE IF (Cap(value[i-1]) = 'M') AND (Cap(value[i]) = 'M') THEN
  196.    un := mm
  197. ELSE IF (Cap(value[i-1]) = 'P') AND (Cap(value[i]) = 'C') THEN
  198.    un := pc
  199. ELSE IF (Cap(value[i-1]) = 'P') AND (Cap(value[i]) = 'T') THEN
  200.    un := pt
  201. ELSE IF (Cap(value[i-1]) = 'P') AND (Cap(value[i]) = 'X') THEN
  202.    un := px
  203. ELSE BEGIN
  204.    WriteString('Bad units in -'); WriteChar(option);
  205.    WriteString(' value:'); WriteChar(' '); WriteString(value); WriteLine;
  206.    WriteString('Last two letters should be cm, mm, in, pc, pt or px.');
  207.    WriteLine; RestoreTerminal; exit(1);
  208. END;
  209. ch1 := value[i-1];                           (* remember letters in units *)
  210. ch2 := value[i];
  211. value[i]   := ' ';                           (* remove units *)
  212. value[i-1] := ' ';
  213. fmt := '%f';
  214. result := sscanf(value,fmt,r);
  215. (* result can be 1 or -1 if ok! *)
  216. IF (ABS(result) <> 1) THEN BEGIN
  217.    value[i-1] := ch1;                        (* restore units *)
  218.    value[i]   := ch2;
  219.    WriteString('Bad -'); WriteChar(option);
  220.    WriteString(' value:'); WriteChar(' '); WriteString(value); WriteLine;
  221.    WriteString('Specify a dimension.'); WriteLine;
  222.    RestoreTerminal; exit(1);
  223. END;
  224. END; (* GetDimen *)
  225.  
  226. (******************************************************************************)
  227.  
  228. FUNCTION DimenPixels (r : REAL; u : units) : INTEGER;
  229.  
  230. (* Return given dimension in terms of pixels. *)
  231.  
  232. BEGIN
  233. CASE u OF
  234.    ic : DimenPixels := TRUNC(r * resolution + 0.5);
  235.    cm : DimenPixels := TRUNC((r / 2.54) * resolution + 0.5);
  236.    mm : DimenPixels := TRUNC((r / 25.4) * resolution + 0.5);
  237.    pt : DimenPixels := TRUNC((r / 72.27) * resolution + 0.5);
  238.    pc : DimenPixels := TRUNC((r / 72.27) * 12.0 * resolution + 0.5);
  239.    px : DimenPixels := TRUNC(r + 0.5)
  240. END;
  241. END; (* DimenPixels *)
  242.  
  243. (******************************************************************************)
  244.  
  245. PROCEDURE InitOptions;
  246.  
  247. (* Get DVI file and any options from command line.
  248.    If an option appears more than once then we return the last value.
  249. *)
  250.  
  251. VAR
  252.    hoffu, voffu, xu, yu : units;
  253.    hoffr, voffr, xr, yr : REAL;
  254.    landscape : boolean;
  255.    temp, strlen, i : integer;
  256.    str : string;
  257.  
  258. BEGIN
  259. (* initialize option values with defaults; note that the dv script can
  260.    set up different defaults
  261. *)
  262. resolution := 300;                           (* LaserWriter resolution *)
  263. hoffu      := ic;
  264. voffu      := ic;
  265. hoffr      := 0.0;                           (* no margin shifting *)
  266. voffr      := 0.0;
  267. xu         := ic;                            (* paper dimensions in inches *)
  268. yu         := ic;
  269. xr         := 8.3;                           (* A4 paper is 8.3" wide *)
  270. yr         := 11.7;                          (* A4 paper is 11.7" high *)
  271. mag        := 0;                             (* use DVI mag *)
  272. vdu        := 'TERM';                        (* SYSDEP: default; see dv *)
  273. fontdir    := '/tex/pk/';                    (* location of PK files *)
  274. dummyfont  := 'cmr10.300pk';                 (* typical font *)
  275. tfmdir     := '/tex/fonts/';                 (* location of PS TFM files *)
  276. psprefix   := 'ps-';                         (* prefix in PS font names *)
  277. helpname   := '/tex/dvitovdu.hlp';           (* file read by ? command *)
  278. DVIname    := ' ';                           (* SYSDEP: empty string *)
  279. landscape  := FALSE;                         (* don't swap -x and -y values *)
  280. argnum := 1;
  281. WHILE argnum < argc DO BEGIN
  282.    value := ' ';
  283.    argv(argnum,value);
  284.    vlength := Len(value);
  285.    argnum := argnum + 1;
  286.    IF value[0] = '-' THEN BEGIN
  287.       IF vlength > 1 THEN option := value[1] ELSE option := ' ';
  288.       CASE option OF
  289.         'r' : BEGIN GetValue; GetCardinal(resolution);    END;
  290.         'm' : BEGIN GetValue; GetCardinal(mag);           END;
  291.         'x' : BEGIN GetValue; GetPosDimen(xr,xu);         END;
  292.         'y' : BEGIN GetValue; GetPosDimen(yr,yu);         END;
  293.         'H' : BEGIN GetValue; GetDimen(hoffr,hoffu);      END;
  294.         'V' : BEGIN GetValue; GetDimen(voffr,voffu);      END;
  295.         'v' : BEGIN GetValue; vdu       := value;         END;
  296.         't' : BEGIN GetValue; tfmdir    := value;         END;
  297.         'p' : BEGIN GetValue; psprefix  := value;         END;
  298.         'f' : BEGIN GetValue; fontdir   := value;         END;
  299.         'd' : BEGIN GetValue; dummyfont := value;         END;
  300.         'h' : BEGIN GetValue; helpname  := value;         END;
  301.               (* bad string values will be detected in other modules *)
  302.         'l' : landscape := TRUE;
  303.       OTHERWISE
  304.          WriteString('Unknown option: -'); WriteChar(option); WriteLine;
  305.          RestoreTerminal; exit(1);
  306.       END;
  307.    END
  308.    ELSE BEGIN
  309.       (* value doesn't start with '-', so assume it is DVI file *)
  310.       DVIname := value;
  311.       IF NOT ExplicitExt(DVIname,vlength) THEN     (* append .dvi *)
  312.          IF vlength + 3 < maxstring THEN BEGIN
  313.             DVIname[vlength]   := '.';
  314.             DVIname[vlength+1] := 'd';
  315.             DVIname[vlength+2] := 'v';
  316.             DVIname[vlength+3] := 'i';
  317.          END
  318.          ELSE BEGIN  (* user has given a mighty long file name *)
  319.             WriteString('DVI file name too long:'); WriteChar(' ');
  320.             WriteString(DVIname); WriteLine;
  321.             RestoreTerminal; exit(1);
  322.          END;
  323.       (* bad DVIname will be detected upon open in main module *)
  324.    END;
  325. END;
  326. IF DVIname[0] = ' ' THEN BEGIN  (* no file name on command line *)
  327.    WriteString('DVI file not given!'); WriteLine;
  328.    RestoreTerminal; exit(1);
  329. END;
  330. (* prepend fontdir to dummyfont *)
  331. str := fontdir;
  332. strlen := Len(fontdir);
  333. FOR i := 1 TO Len(dummyfont) DO BEGIN
  334.    IF strlen < maxstring THEN BEGIN
  335.       str[strlen] := dummyfont[i-1];
  336.       strlen := strlen + 1;
  337.    END;
  338. END;
  339. dummyfont := str;
  340. (* set h/voffset and paperwd/ht only after resolution has been decided *)
  341. hoffset := DimenPixels(hoffr,hoffu);
  342. voffset := DimenPixels(voffr,voffu);
  343. paperwd := DimenPixels(xr,xu);
  344. paperht := DimenPixels(yr,yu);
  345. IF landscape THEN BEGIN   (* swap paperwd and paperht *)
  346.    temp := paperwd;
  347.    paperwd := paperht;
  348.    paperht := temp;
  349. END;
  350. END; (* InitOptions *)
  351.